library(here)
library(sf)
library(leaflet)
library(tidyverse)
library(readxl)
library(shiny)
library(dplyr)
library(plotly)
library(DT)
library(tidyr)
library(ggiraph)
library(ggplot2)
library(patchwork)China in the Development World
Irene Chen, Crystal Yixin Luo, Vaishnavi Singh, Gabriel Soto, Tian Tong
Introduction
This project will showcase the impact of China’s role in the global arena, specifically in the Infrastructure development industry. We will explore several regions and countries that have benefited from this negotiations. This dataset is public and sources are several.
1. Data Importing
1.1 Load and filter the original dataset
#getting specific columns
df_filtered <- df %>% select(
"AidData Record ID", "Financier Country", "Recipient",
"Recipient Region", "Commitment Year", "Completion Year",
"Title", "Description", "Status", "Intent",
"Flow Type Simplified", "Flow Class", "Sector Name",
"Infrastructure", "Funding Agencies Type",
"Implementing Agencies Type",
"Adjusted Amount (Constant USD 2021)",
"Location Narrative", "OECD ODA Income Group",
"Geographic Level of Precision Available",
"Geospatial Feature Available",
"Interest Rate", # Added
"Grace Period"
)
#filtering to get 961 projects with geospatial features
df_filtered <- df_filtered %>%
filter(`Flow Class` != "Vague (Official Finance)",
`Adjusted Amount (Constant USD 2021)` > 100000000.00,
`Geographic Level of Precision Available` == "Precise",
`Geospatial Feature Available` == "Yes")1.2 Load and process the GeoJSON files
loads individual GeoJSON files into a list
# Absolute path to directory
geojson_dir <- "./data-spatial"
# Get file paths
geojson_files <- list.files(path = geojson_dir, pattern = "\\.(geojson|GeoJSON|json)$", full.names = TRUE)
geojson_files <- list.files(path = geojson_dir, pattern = "\\.geojson$", full.names = TRUE)
# Read files into list
geojson_list <- lapply(geojson_files, st_read, quiet = TRUE)
names(geojson_list) <- basename(geojson_files)matches GeoJSON features with AidData records and adds properties
# Iterate and add properties
geojson_list <- lapply(geojson_list, function(geojson) {
# Get the GeoJSON's unique identifier (assumes it's in a column `id`)
geo_id <- geojson$id[1] # Replace with the actual name of your `id` field
# Match the row in `df`
matched_row <- df_filtered %>% filter(`AidData Record ID` == geo_id)
# Add the properties if a match is found
if (nrow(matched_row) > 0) {
geojson$Title <- matched_row$Title
geojson$Amount <- matched_row$Amount
geojson$Status <- matched_row$Status
geojson$`Recipient Region` <- matched_row$`Recipient Region`
geojson$Description <- matched_row$Description
geojson$Intent <- matched_row$Intent
geojson$`Flow Type Simplified` <- matched_row$`Flow Type Simplified`
geojson$`Flow Class` <- matched_row$`Flow Class`
geojson$`Funding Agencies Type` <- matched_row$`Funding Agencies Type`
geojson$`Implementing Agencies Type` <- matched_row$`Implementing Agencies Type`
geojson$`Location Narrative` <- matched_row$`Location Narrative`
geojson$`OECD ODA Income Group` <- matched_row$`OECD ODA Income Group`
} else {
# If no match, assign default or NA
geojson$Title <- NA
geojson$Amount <- NA
geojson$Status <- NA
geojson$`Recipient Region` <- NA
geojson$Description <- NA
geojson$Intent <- NA
geojson$`Flow Type Simplified` <- NA
geojson$`Flow Class` <- NA
geojson$`Funding Agencies Type` <- NA
geojson$`Implementing Agencies Type` <- NA
geojson$`Location Narrative` <- NA
geojson$`OECD ODA Income Group` <- NA
}
return(geojson)
})Combining and Fixing Geometries:
combined_geojson <- do.call(rbind, geojson_list) %>%
st_make_valid() %>%
# Add coordinate check
{
invalid_geoms <- st_is_valid(., reason = TRUE)
print(paste("Invalid geometries found:", sum(invalid_geoms != "Valid Geometry")))
.
} %>%
# Remove any remaining invalid geometries
filter(st_is_valid(.)) %>%
# Ensure proper CRS
st_transform(4326)[1] "Invalid geometries found: 0"
# Print summary for verification
print(paste("Total features:", nrow(combined_geojson)))[1] "Total features: 961"
print(paste("Unique regions:", length(unique(combined_geojson$`Recipient Region`))))[1] "Unique regions: 6"
2. Creating Interactive Plots
2.1 Interactive line Plots
# Calculate yearly averages
yearly_metrics <- df_filtered %>%
group_by(`Commitment Year`) %>%
summarise(
avg_interest_rate = mean(`Interest Rate`, na.rm = TRUE),
avg_grace_period = mean(`Grace Period`, na.rm = TRUE),
project_count = n()
) %>%
filter(!is.na(`Commitment Year`)) # Remove any NA years# Create a data frame with Chinese domestic interest rates for the relevant years
chinese_rates <- data.frame(
year = c(2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020,2021),
rate = c(3.24, 3.24, 2.70, 2.70, 3.33, 3.33, 3.33, 3.33, 3.9375, 2.79, 2.8283,
3.25, 3.25, 3.25, 3.25, 2.90, 2.90, 2.90, 2.90, 2.90, 2.90,2.90)
)
# Modified plot with added Chinese interest rate line
p <- plot_ly(yearly_metrics, x = ~`Commitment Year`) %>%
add_trace(
y = ~avg_interest_rate,
name = 'Interest Rate',
type = 'scatter',
mode = 'lines+markers',
line = list(color = '#8884d8'),
marker = list(color = '#8884d8', size = 8),
hovertemplate = paste(
"Year: %{x}<br>",
"Interest Rate: %{y:.2f}%<br>",
"<extra></extra>"
)
) %>%
add_trace(
y = ~avg_grace_period,
name = 'Grace Period',
type = 'scatter',
mode = 'lines+markers',
line = list(color = '#82ca9d'),
marker = list(color = '#82ca9d', size = 8),
hovertemplate = paste(
"Year: %{x}<br>",
"Grace Period: %{y:.2f} years<br>",
"<extra></extra>"
)
) %>%
# Add Chinese domestic interest rate line
add_trace(
data = chinese_rates,
x = ~year,
y = ~rate,
name = 'China Domestic Rate',
type = 'scatter',
mode = 'lines',
line = list(color = '#FF6B6B', dash = 'dot'),
hovertemplate = paste(
"Year: %{x}<br>",
"Domestic Rate: %{y:.2f}%<br>",
"<extra></extra>"
)
) %>%
layout(
title = list(
text = 'Average Interest Rate and Grace Period by Commitment Year',
x = 0.5,
y = 0.95,
font = list(size = 20)
),
xaxis = list(
title = 'Commitment Year',
gridcolor = '#E2E2E2',
showgrid = TRUE
),
yaxis = list(
title = 'Years / Percentage',
gridcolor = '#E2E2E2',
showgrid = TRUE,
range = c(0, 7)
),
legend = list(
title = list(text = 'Metric'),
orientation = 'h',
y = 1.1,
x = 0.5,
xanchor = 'center',
yanchor = 'bottom'
),
margin = list(t = 100),
hoverlabel = list(bgcolor = "white"),
plot_bgcolor = '#FFFFFF',
paper_bgcolor = '#FFFFFF'
)
# Display the plot
pInterest Rate Trends:
Started high around 6.3% in 2000 and showed a general declining trend
Shows some volatility but less extreme than grace period changes
Typically remained higher than China’s domestic rate until around 2008-2009
Grace Period Patterns:
Much more volatile than interest rates, especially in early years
Shows a slight declining trend in recent years (2015-2020)
2.2 Interactive Linked Scatter plot with Python
3. Creating plots with Shiny App
3.1 Creating Comprehensive Overview Dashboard
Using the original polygons instead of circled markers
Adding a tab for Analysis with: (a) a Barplot to show Sector-wise distribution; (b) a Pie Chart to show project status distribution
Adding a stacked bar plot to show Regional Variation across sectors
Adding a tab for Data table (allowing filter selection)
https://yc1171.shinyapps.io/shiny-2/
Combined dashboards:
# UI
ui <- fluidPage(
titlePanel("China Development Finance Projects"),
sidebarLayout(
sidebarPanel(width = 3,
selectInput("region_filter",
"Filter by Region:",
choices = c("All", sort(unique(combined_geojson$`Recipient Region`)))),
selectInput("sector_filter",
"Filter by Sector:",
choices = c("All", sort(unique(combined_geojson$Sector.Name)))),
checkboxGroupInput("status_filter",
"Project Status:",
choices = sort(unique(combined_geojson$Status))),
sliderInput("amount_filter",
"Investment Amount (USD Millions):",
min = 0,
max = 10000, # Natural limit for better display
value = c(0, 10000), # Default slider range
step = 1),
actionButton("reset", "Reset Filters", class = "btn-primary")
),
mainPanel(width = 9,
fluidRow(
column(4,
div(class = "well well-sm",
h4("Total Projects"),
textOutput("total_projects"))),
column(4,
div(class = "well well-sm",
h4("Total Investment (USD Billions)"),
textOutput("total_investment"))),
column(4,
div(class = "well well-sm",
h4("Average Project Size (USD Millions)"),
textOutput("avg_project")))
),
tabsetPanel(
tabPanel("Map View", leafletOutput("map", height = "600px")),
tabPanel("Analysis",
fluidRow(
column(6, plotlyOutput("sector_plot")),
column(6, plotlyOutput("status_plot"))
),
plotlyOutput("regional_plot")),
tabPanel("Data Table", DTOutput("project_table"))
)
)
)
)
# Server
server <- function(input, output, session) {
# Reset button functionality
observeEvent(input$reset, {
updateSelectInput(session, "region_filter", selected = "All")
updateSelectInput(session, "sector_filter", selected = "All")
updateCheckboxGroupInput(session, "status_filter", selected = character(0))
updateSliderInput(session, "amount_filter",
min = 0,
max = 10000, # Reset to default limits
value = c(0, 10000))
})
# Reactive data based on filters
filtered_data <- reactive({
data <- combined_geojson
if (input$region_filter != "All") {
data <- data %>% filter(`Recipient Region` == input$region_filter)
}
if (input$sector_filter != "All") {
data <- data %>% filter(Sector.Name == input$sector_filter)
}
if (length(input$status_filter) > 0) {
data <- data %>% filter(Status %in% input$status_filter)
}
data <- data %>%
filter(Amount..Constant.USD.2021./1e6 >= input$amount_filter[1],
Amount..Constant.USD.2021./1e6 <= input$amount_filter[2])
validate(
need(nrow(data) > 0, "No projects match the selected filters")
)
data
})
# Map
output$map <- renderLeaflet({
req(filtered_data())
pal <- colorFactor(palette = "viridis", domain = unique(filtered_data()$Sector.Name))
leaflet(filtered_data()) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(
fillColor = ~pal(Sector.Name),
color = ~pal(Sector.Name),
weight = 2,
opacity = 1,
fillOpacity = 0.7,
highlightOptions = highlightOptions(
weight = 3,
color = "white",
fillOpacity = 1,
bringToFront = TRUE
),
popup = ~paste0(
"<strong>Title:</strong> ", Title, "<br>",
"<strong>Amount:</strong> $", formatC(Amount..Constant.USD.2021./1e6, format = "f", digits = 1, big.mark = ","), "M<br>",
"<strong>Status:</strong> ", Status, "<br>",
"<strong>Sector:</strong> ", Sector.Name
)
) %>%
addLegend(
position = "bottomright",
pal = pal,
values = ~Sector.Name,
title = "Sectors",
opacity = 1
)
})
# Sector plot
output$sector_plot <- renderPlotly({
sector_data <- filtered_data() %>%
st_drop_geometry() %>%
group_by(Sector.Name) %>%
summarise(Total = sum(Amount..Constant.USD.2021./1e6, na.rm = TRUE)) %>%
arrange(desc(Total))
plot_ly(
data = sector_data,
x = ~Total,
y = ~reorder(Sector.Name, Total),
type = 'bar',
orientation = 'h',
marker = list(color = "blue")
) %>%
layout(
title = "Top Sectors by Investment",
xaxis = list(title = "Investment (USD Millions)"),
yaxis = list(title = ""),
showlegend = FALSE
)
})
# Status plot
output$status_plot <- renderPlotly({
status_data <- filtered_data() %>%
st_drop_geometry() %>%
group_by(Status) %>%
summarise(Count = n()) %>%
mutate(Percentage = Count/sum(Count) * 100)
plot_ly(
data = status_data,
labels = ~Status,
values = ~Count,
type = "pie",
textinfo = "label+percent",
marker = list(colors = c("#2ecc71", "#3498db", "#e74c3c"))
) %>%
layout(
title = "Project Status Distribution",
showlegend = TRUE
)
})
# Regional Distribution Plot
output$regional_plot <- renderPlotly({
regional_data <- filtered_data() %>%
st_drop_geometry() %>%
group_by(`Recipient Region`, Sector.Name) %>%
summarise(TotalInvestment = sum(Amount..Constant.USD.2021., na.rm = TRUE)) %>%
arrange(desc(TotalInvestment))
plot_ly(
data = regional_data,
x = ~`Recipient Region`,
y = ~TotalInvestment / 1e6,
type = 'bar',
color = ~Sector.Name,
colors = viridis::viridis_pal(option = "D")(length(unique(regional_data$Sector.Name))),
text = ~paste(
"Region:", `Recipient Region`, "<br>",
"Sector:", Sector.Name, "<br>",
"Investment:", scales::comma(TotalInvestment / 1e6, suffix = "M")
),
hoverinfo = "text"
) %>%
layout(
title = "Regional Distribution of Investments by Sector",
xaxis = list(title = "Region"),
yaxis = list(title = "Investment (USD Millions)"),
barmode = "stack",
font = list(size = 12) # Improved font size for clarity
)
})
# Summary statistics
output$total_projects <- renderText({
nrow(filtered_data())
})
output$total_investment <- renderText({
total <- sum(filtered_data()$Amount..Constant.USD.2021., na.rm = TRUE) / 1e9
paste0("$", formatC(total, format = "f", digits = 1, big.mark = ","), "B")
})
output$avg_project <- renderText({
avg <- mean(filtered_data()$Amount..Constant.USD.2021., na.rm = TRUE) / 1e6
paste0("$", formatC(avg, format = "f", digits = 1, big.mark = ","), "M")
})
# Data table
output$project_table <- renderDT({
filtered_data() %>%
st_drop_geometry() %>%
datatable(options = list(pageLength = 10), rownames = FALSE)
})
}
# Run the Shiny app
shinyApp(ui = ui, server = server)3.2 Creating OECD ODA Income Group Dashboard
https://yl1652.shinyapps.io/china-development-by-income-group/
# UI
ui <- fluidPage(
titlePanel("OECD ODA Income Group Dashboard"),
sidebarLayout(
sidebarPanel(width = 3,
div(class = "well well-sm",
h4("Total Projects"),
textOutput("total_projects")),
div(class = "well well-sm",
h4("Total Investment (USD Billions)"),
textOutput("total_investment")),
selectInput("income_group_filter",
"Filter by Income Group:",
choices = c("All", sort(unique(combined_geojson$`OECD ODA Income Group`)))),
sliderInput("amount_filter",
"Investment Amount (USD Millions):",
min = 0,
max = max(combined_geojson$Amount..Constant.USD.2021./1e6, na.rm = TRUE),
value = c(0, max(combined_geojson$Amount..Constant.USD.2021./1e6, na.rm = TRUE))),
sliderInput("completion_year_filter",
"Filter by Completion Year:",
min = min(as.numeric(combined_geojson$Completion.Year), na.rm = TRUE),
max = max(as.numeric(combined_geojson$Completion.Year), na.rm = TRUE),
value = c(min(as.numeric(combined_geojson$Completion.Year), na.rm = TRUE),
max(as.numeric(combined_geojson$Completion.Year), na.rm = TRUE)),
step = 1)
),
mainPanel(width = 9,
fluidRow(
column(4,
div(style = "height: 300px;",
plotlyOutput("income_group_plot"))),
column(8, leafletOutput("map", height = "600px"))
)
)
)
)
# Server
server <- function(input, output, session) {
# Filtered data
filtered_data <- reactive({
data <- combined_geojson
if (!is.null(input$income_group_filter) && input$income_group_filter != "All") {
data <- data %>%
filter(`OECD ODA Income Group` == input$income_group_filter)
}
amount_mil <- input$amount_filter
data <- data %>%
filter(Amount..Constant.USD.2021./1e6 >= amount_mil[1],
Amount..Constant.USD.2021./1e6 <= amount_mil[2]) %>%
filter(Completion.Year >= input$completion_year_filter[1],
Completion.Year <= input$completion_year_filter[2])
data
})
# Income group plot
output$income_group_plot <- renderPlotly({
group_data <- filtered_data() %>%
st_drop_geometry() %>%
group_by(`OECD ODA Income Group`) %>%
summarise(Total = sum(Amount..Constant.USD.2021./1e6, na.rm = TRUE)) %>%
arrange(desc(Total))
plot_ly(group_data,
x = ~reorder(`OECD ODA Income Group`, Total),
y = ~Total,
type = "bar",
color = ~`OECD ODA Income Group`, # Assign colors by category
colors = viridis::viridis(length(unique(group_data$`OECD ODA Income Group`)), option = "D") # Use a predefined color palette
) %>%
layout(
title = "Investment by Income Group",
xaxis = list(title = "Income Group"),
yaxis = list(title = "USD Millions"),
margin = list(l = 100),
showlegend = FALSE
)
})
# Map
output$map <- renderLeaflet({
req(filtered_data())
filtered <- filtered_data()
if (nrow(filtered) > 0) {
pal <- colorFactor(palette = viridis::viridis(length(unique(filtered$`OECD ODA Income Group`)), option = "D"), domain = unique(filtered$`OECD ODA Income Group`), na.color = "grey")
centroids <- st_centroid(st_make_valid(filtered))
coords <- st_coordinates(centroids)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(
data = filtered,
lng = coords[,1],
lat = coords[,2],
radius = 8,
color = ~pal(`OECD ODA Income Group`),
fillOpacity = 0.7,
stroke = TRUE,
weight = 1,
popup = ~paste(
"<div style='max-width: 300px;'>",
"<strong>Title:</strong>", Title, "<br>",
"<strong>Amount:</strong> $", formatC(Amount..Constant.USD.2021./1e6, format="f", digits=1, big.mark=","), "M<br>",
"<strong>Income Group:</strong>", `OECD ODA Income Group`,
"</div>"
),
label = ~Title
) %>%
addLegend(
position = "bottomright",
pal = pal,
values = unique(filtered$`OECD ODA Income Group`),
title = "Income Groups",
opacity = 0.7
)
} else {
leaflet() %>% addProviderTiles("CartoDB.Positron") # Render an empty map
}
})
# Summary statistics
output$total_projects <- renderText({
nrow(filtered_data())
})
output$total_investment <- renderText({
total <- sum(filtered_data()$Amount..Constant.USD.2021., na.rm = TRUE) / 1e9
paste0("$", formatC(total, format="f", digits=1, big.mark=","), "B")
})
}
# Run app
shinyApp(ui = ui, server = server)